home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
techs.zip
/
TECH4.ZIP
/
LABEL1.PRG
next >
Wrap
Text File
|
1985-11-01
|
3KB
|
99 lines
PROCEDURE Dolabel
* Author ....: Luis Castro revised by Christopher White
* Date ......: August 1, 1985
* Version ...: dBASE III, any version
* Note(s) ...: Prints more than one label across without
* printing a blank line when the Company field is
* blank. Use a database file with the following
* structure.
*
* Name Character <any length>
* Company Character <any length>
* Address Character <any length>
* City Character <any length>
* State Character <any length>
* Zip Character <any length>
*
PARAMETERS filename, ndx, condition, nacross, lablen, between, printer
USE &filename
IF "" <> indx
SET INDEX TO &indx
ENDIF
SET FILTER TO &condition
GO TOP
IF nacross > 4
nacross = 4
ENDIF
* ---Print labels.
CLEAR
DO WHILE .NOT. EOF()
* ---Store first column to output lines.
STORE "" TO line1, line2, line3, line4
DO Format WITH TRIM( Name ), line1
IF Company = " "
DO Format WITH TRIM( Address ),line2
DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line3
DO Format WITH " ", line4
ELSE
DO Format WITH TRIM( Company ), line2
DO Format WITH TRIM( Address ), line3
DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line4
ENDIF
* ---Store rest of columns to output lines.
IF nacross > 1
SKIP
ENDIF
column = 1
DO WHILE .NOT. EOF() .AND. column < nacross
DO Format WITH TRIM( Name ),line1
IF Company = " "
DO Format WITH TRIM( Address ),line2
DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line3
DO Format WITH " ", line4
ELSE
DO Format WITH TRIM( Company ), line2
DO Format WITH TRIM( Address ), line3
DO Format WITH TRIM( City ) + ", " + State + " " + Zip, line4
ENDIF
column = column + 1
IF column < nacross
SKIP
ENDIF
ENDDO
* ---Print output line.
IF printer = "Y"
SET CONSOLE OFF
SET PRINT ON
ENDIF
? line1
? line2
? line3
? line4
?
?
IF printer = "Y"
SET PRINT OFF
SET CONSOLE ON
ENDIF
IF .NOT. EOF()
SKIP
ENDIF
ENDDO
CLOSE DATABASE
RETURN
* EOP Dolabel
PROCEDURE Format
PARAMETERS exp, pline
fstring = SUBSTR( exp,1,lablen )
DO CASE
CASE " " = exp
fstring = SPACE( lablen )
CASE LEN( fstring ) < lablen
fstring = fstring + SPACE( lablen - LEN( exp ))
ENDCASE
fstring = fstring + SPACE( between )
pline = pline + fstring
RETURN
* EOP Format